#!/usr/bin/perl -w
use strict;
use File::Path;
use File::Spec::Functions;
use Cwd qw(abs_path);
use Storable;
use YAML;

our %params = (
    dmoz_dir        => '/home/xqy/dmoz',
    topics_dir      => 'topics',
    list_file       => 'list',
    follow_symlink  => 1,
    threads_cnt     => 50,
    download_script => 'scripts/batch_download.pl',
    build_tfidf_script => 'classifier/topic2tfidf.pl',
    sample_tfidf_file => 'data/tfidf',
    idf_yml_file    => 'data/idf.yml',
    classifier_file => 'classifier',
    seeds_file      => 'seeds',
    dump_dir        => 'dump',
    tfidf_file      => 'tfidf',
);

unless (@ARGV == 1) {
    print STDERR "Usage: $0 <topic>\n";
    die;
}

my $dmoz_dir = $params{dmoz_dir};
chdir $dmoz_dir or die "$!";

$params{$_} = File::Spec->rel2abs($params{$_}) for qw(download_script build_tfidf_script sample_tfidf_file idf_yml_file);

my $topic = shift;

die "Your dir doesn't exists!\n"
  unless -d $topic;

(my $topic_dir = $topic) =~ s/\//\./g;
my $topics_dir = $params{topics_dir};
mkdir $topics_dir unless -d $topics_dir;
$topic_dir = catfile($topics_dir, $topic_dir);
rmtree $topic_dir if -d $topic_dir;
mkdir $topic_dir unless -d $topic_dir;

print "Collecting seed URLs...\n";
my %seed_urls = %{&collect_seeds($topic)};
chdir $topic_dir or die "$!";
mkdir $params{dump_dir} unless -d $params{dump_dir};

open SEEDS, "> $params{seeds_file}" or die "$!";
print SEEDS $_, "\n" for keys %seed_urls;
close SEEDS;
printf "Done! %d seeds URLs collected.\n", scalar(keys %seed_urls);

print "Start downloading seed URLs...\n";
system 'perl', $params{download_script}, $params{seeds_file}, $params{dump_dir}, $params{threads_cnt};
print "Done!\n";

print "Start building tfidf file...\n";
system 'perl', $params{build_tfidf_script}, $params{dump_dir}, $params{idf_yml_file}, $params{tfidf_file};
open TFIDF, ">> $params{tfidf_file}" or die "$!";
open SAMPLE_TFIDF, "< $params{sample_tfidf_file}" or die "$!";
while (<SAMPLE_TFIDF>) {
    chomp(my $url = $_);
    my $line = <SAMPLE_TFIDF>;
    print TFIDF "-1 $line" unless exists $seed_urls{$url};
}
close SAMPLE_TFIDF;
close TFIDF;

print "Done!\n";

print "Start learning...\n";

my $idf_ref = YAML::LoadFile($params{idf_yml_file});
my $total = $idf_ref->{TOTAL};
my @index2pair;
while (my($token, $ref) = each %$idf_ref) {
  next if $token eq 'TOTAL';
  my ($index, $idf) = @$ref;
  $index2pair[$index] = [$token, $idf];
}
undef $idf_ref;


open IN, "< tfidf" or die "$!";
open TRAIN, "> train" or die "$!";
open VALIDATE, "> validate" or die "$!";

my $count = 0;   
while (<IN>) {
  $count++;
  if ($count % 3 == 0) {
    print VALIDATE;
  } else {
    print TRAIN;
  }
}
close IN;
close TRAIN;
close VALIDATE;

my ($svm_learn, $svm_classify) = (catfile($dmoz_dir, 'tools/svm_learn'), catfile($dmoz_dir, 'tools/svm_classify'));
system $svm_learn, 'train', 'model';
while (1) {
  system $svm_classify, 'validate',  'model';
  print "Are you satisfied with your clasifier's performance on the validation set? (y/n)\n";
  my $yesOrNo = <STDIN>;
  last if $yesOrNo =~ /^y/i;
  print "Please manually edit your model file. Press any key to continue...";
  <STDIN>;
}
my $bias = &getBias("model");
print "Your tuned threshold is: $bias\n";
system $svm_learn, 'tfidf', 'model';
print "Done!\n";

open IN, "< model" or die "$!";
while (<IN>) {
  if (/^(\S+) # threshold/) {
    last;
  }
}

my @weights;

while (<IN>) {
  /^(\S+) (.+) #/;
  my $alpha = $1;
  my $pairs = $2;
  next unless defined $pairs;
  while ($pairs =~ /(\S+):(\S+)/g) {
    $weights[$1] += $alpha * $2;
  }
}
close IN;
unlink 'model', 'train', 'validate', 'svm_predictions', 'model~';
rmtree $params{dump_dir};

my %classifier;
$classifier{TOTAL} = $total;
$classifier{BIAS} = $bias;

for (1..$#weights) {
  next unless $weights[$_];
  my ($token, $idf) = @{$index2pair[$_]};
  $classifier{$token} = [$weights[$_], $idf];
}

Storable::store(\%classifier, $params{classifier_file});

print "Done!\n";

sub collect_seeds {
    my ($topic_root) = shift;
    my $seeds_ref = {};
    my %dirs_seen;
    my @dirs = (&get_canonical('.', $topic_root));
    while (@dirs) {
        my $dir = shift @dirs;
        next unless defined $dir;
        #print $dir, "\n";
        my $list_file = catfile($dir, $params{list_file});
        if (-e $list_file) {
            open IN, "< $list_file" or die "$!";
            while (<IN>) {
                chomp;
                $seeds_ref->{$_} = 1;
            }
            close IN;
        }
        opendir DIR, $dir or die "$!";
        my @sub_dirs;
        foreach my $entry (readdir DIR) {
            next if $entry =~ /^\.{1,2}$/;
            my $sub_dir = catfile($dir, $entry);
            next unless -d $sub_dir; 
            $sub_dir = &get_canonical($dir, $sub_dir);
            next unless defined $sub_dir;
            if (exists $dirs_seen{$sub_dir}) {
                print STDERR "$sub_dir duplicated!\n";
            } else {
                $dirs_seen{$sub_dir} = 1;
                push @sub_dirs, $sub_dir;
            }
        }
        unshift @dirs, @sub_dirs;
        closedir DIR;
    }	
    $seeds_ref;
}

sub getBias{
  (my $file) = @_;
  open MODEL, "<$file" or die "$!";
  while (<MODEL>) {
    next unless /^(\S+) # threshold/;
    close MODEL;
    return $1;
  }
}

sub get_canonical {
    my ($parent, $sub_dir) = @_;
    if (-l $sub_dir) {
        return undef unless $params{follow_symlink};
        my $abs = File::Spec->rel2abs(readlink($sub_dir), $parent);
        my $canon = abs_path($abs);
        return File::Spec->abs2rel($canon);
    }
    else {
        return $sub_dir
    }
}
